Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-02/pascala.zip/COMPSORT.PAS

Pascal/Delphi Source File | 1991-05-06 | 5KB | 190 lines

(*****************************************)
(*  Alejo Alamillo                *)
(*  COSC 055                 *)
(*  SPRING 1991                 *)
(*                     *)
(*****************************************)

(*******************************************************)
(*  Compsorts is a program which uses several          *)
(*  sorting methods and compares their execution times *)
(*  The main program and Shellsort are to be completed *)
(*        PRB  10/23/90                                *)
(*******************************************************)
PROGRAM Compsorts(Input,Output,File1);

CONST MaxSize = 8192;
TYPE  ArrayType = ARRAY[0..MaxSize] OF Integer;
VAR B,C,D,E,F,G: ArrayType;
    StartTime, EndTime, Size: Integer;
    File1: Text;
(**************************************************)
(*  Bubble Sort                                   *)
(**************************************************)
  PROCEDURE BubbleSort(VAR A: ArrayType; Size: Integer);
  VAR I, Pass, Temp: Integer;
      NoExchg:  Boolean;

  BEGIN
  Pass:= 0;
  REPEAT
    NoExchg:= True;
    Pass:= Pass + 1;
    FOR I:= 1 TO Size - Pass DO
      IF A[I] < A[I+1] THEN
        BEGIN
        Temp:= A[I];
        A[I]:= A[I+1];
        A[I+1]:= Temp;
        NoExchg:= False;
        END;
  UNTIL Noexchg OR (Pass = Size-1);
  END;
(***********************************************************)
(*  Selection sort--find the smallest element and place it *)
(***********************************************************)
PROCEDURE SelectSort(VAR A: ArrayType; Size: Integer);

  VAR Pass, I, J, K, S: Integer;

  BEGIN
  FOR Pass:= 1 TO Size DO
    BEGIN
    K:= Pass;  (* Points to location of smallest remaining entry *)
    S:= A[K];
    FOR I:= Pass + 1 TO Size DO   (* Find smallest      "       "   *)
      IF A[I] < S THEN
        BEGIN
        S:= A[I];
        K:= I;
        END;
    A[K]:= A[Pass];
    A[Pass]:= S;      (* Switch *)
    END;  (* Pass *)
  END;
(***********************************************************)
(*  Insertion Sort  (Refined)                              *)
(*  Assumes a 'stopper--impossibly small' at entry zero    *)
(***********************************************************)
  PROCEDURE InsertSort(VAR A: ArrayType; Size: Integer);
    VAR  Pass, I, S:  Integer;
    BEGIN
    FOR Pass:= 2 TO Size DO  (* Insert item 'Pass' *)
      BEGIN
      I:= Pass;
      S:= A[Pass];   (* Copy item to be inserted *)
      WHILE S < A[I-1] DO
        BEGIN
        A[I]:= A[I-1]; (* Move item down in list *)
        I:= I-1;
        END;
      A[I]:= S;  (* Perform Insertion *)
      END;
    END;

(*********************************************************)
(*  ShellSort                                            *)
(*********************************************************)
PROCEDURE ShellSort(VAR A: ArrayType; Size:Integer);
  VAR
    I,J,K,S,N:INTEGER;
  BEGIN
    N := SIZE;
    I := N DIV 2;
    WHILE I > 0 DO
      BEGIN
      J := I;
      REPEAT
        J := J + 1;
        K := J - 1;
        WHILE K > 0 DO
          BEGIN
          IF A[K] > A[K+I] THEN
            BEGIN
            S := A[K];
            A[K] := A[K+I];
            A[K+I] := S;
            K := K - I;
            END
          ELSE
            K := 0
        END
      UNTIL J = N;
      I := I DIV 2
      END
  END; (* SHELL SORT *)

(*********************************************************)
(*  QuickSort-- Recursive version                        *)
(*********************************************************)
  PROCEDURE QuickSort(VAR A: ArrayType; Size:Integer);

    PROCEDURE Sort(L,R: Integer);
      VAR Temp, I, J, StartValue: Integer;
      BEGIN
      I:= L;
      J:= R;
      StartValue:= A[(L+R) DIV 2];
      REPEAT
        WHILE A[I] < StartValue DO  (* Search from left *)
          I:= I+1;
        WHILE A[J] > StartValue DO (* Search from right *)
          J:= J-1;
        IF I<=J THEN
          BEGIN
          Temp:= A[I];
          A[I]:= A[J];
          A[J]:= Temp;
          I:= I+1;
          J:= J-1;
          END;
      UNTIL  I >= J;
      IF L < J THEN Sort(L,J);
      IF I < R THEN Sort(I,R);
    END;  (* Sort *)
  BEGIN
  Sort(1, Size);
  END;


BEGIN   (*******************  MAIN  ***********************)
Reset(File1);
B[0]:= 0;    (* Bumper for top of list *)
Size:= 0;
WHILE not Eof(File1) DO
  BEGIN
  Size:= Size + 1;
  Readln(File1,B[Size]);
  END;
C:= B; D:= B; E:= B; F:= B; G :=B;

Writeln('Array Size: ',Size:0);
Writeln;

StartTime:= Clock;
BubbleSort(B, Size);
EndTime:= Clock;
Writeln('BubbleTime: ',EndTime-StartTime:0);

StartTime:= Clock;
SelectSort(C,Size);
EndTime:= Clock;
Writeln('SelectTime: ',EndTime-StartTime:0);

StartTime:= Clock;
InsertSort(D, Size);
EndTime:= Clock;
Writeln('InsertTime: ',EndTime-StartTime:0);

StartTime:=Clock;
ShellSort(F,Size);
EndTime:=Clock;
Writeln('ShellTime:  ',EndTime-StartTime:0);

StartTime:= Clock;
QuickSort(G, Size);
EndTime:= Clock;
Writeln('QuickTime:  ',EndTime-StartTime:0);

END.     (****************  COMPSORTS  **********************)